Package R yang akan digunakan pada perkuliahan Analisis
Deret Waktu sesi UTS adalah: forecast,
graphics, TTR, TSA . Jika
package tersebut belum ada, silakan install terlebih
dahulu.
#install.packages("forecast")
#install.packages("graphics")
#install.packages("TTR")
#install.packages("TSA")
#install.packages("ggplot2")
Jika sudah ada, silakan panggil library package tersebut.
library("forecast")
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo
library("graphics")
library("TTR")
library("TSA")
## Registered S3 methods overwritten by 'TSA':
## method from
## fitted.Arima forecast
## plot.Arima forecast
##
## Attaching package: 'TSA'
## The following objects are masked from 'package:stats':
##
## acf, arima
## The following object is masked from 'package:utils':
##
## tar
library("ggplot2")
Data yang digunakan pada analisis ini ialah data bursa saham dengan peubah volume(juta) bursa saham. Volume bursa saham adalah data yang mengukur jumlah saham yang diperdagangkan dalam suatu instrumen keuangan (seperti saham, obligasi, atau reksa dana) selama suatu periode waktu tertentu di pasar saham. Data volume memberikan informasi tentang sejauh mana pasar aktif pada suatu hari perdagangan dan dapat memberikan wawasan tentang minat dan partisipasi investor dalam aset tersebut. Volume perdagangan yang tinggi sering menjadi pertanda bahwa terdapat minat yang besar dalam aset tersebut, sementara volume yang rendah dapat menunjukkan kurangnya minat atau ketidakpastian di pasar.
Data yang digunakan berasal dari www.bps.go.id
library(rio)
datampdw <- import("https://raw.githubusercontent.com/RadhityaHarma12/MPDW/main/Pertemuan%201/datampdw.csv")
Melihat data menggunakan fungsi View(), struktur data
menggunakan fungsi str(), dan dimensi data menggunakan
fungsi dim().
View(datampdw)
str(datampdw)
## 'data.frame': 120 obs. of 2 variables:
## $ date: chr "Jan-13" "Feb-13" "Mar-13" "Apr-13" ...
## $ x : int 97907 136954 141112 128263 135960 119400 95011 91423 113009 100552 ...
dim(datampdw)
## [1] 120 2
Mengubah data agar terbaca sebagai data deret waktu dengan fungsi
ts() .
datampdw.ts <- ts(datampdw$x)
Menampilkan ringkasan data
summary(datampdw.ts)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 78078 121592 198502 239331 304183 649089
Membuat plot data deret waktu
ts.plot(datampdw.ts, xlab="Time Period ", ylab="Volume Saham",
main = "Time Series Plot")
points(datampdw.ts)
Menyimpan plot
#menyimpan plot
#dev.copy(png, "eksplorasi.png")
#dev.off()
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi data latih dan data uji
training_ma <- datampdw[1:96,]
testing_ma <- datampdw[97:120,]
train_ma.ts <- ts(training_ma$x)
test_ma.ts <- ts(testing_ma$x)
Eksplorasi data dilakukan pada keseluruhan data, data latih serta data uji menggunakan plot data deret waktu.
#eksplorasi keseluruhan data
plot(datampdw.ts, col="red",main="Plot semua data")
points(datampdw.ts)
#eksplorasi data latih
plot(train_ma.ts, col="blue",main="Plot data latih")
points(train_ma.ts)
#eksplorasi data uji
plot(test_ma.ts, col="blue",main="Plot data uji")
points(test_ma.ts)
Eksplorasi data juga dapat dilakukan menggunakan package
ggplot2 dengan terlebih dahulu memanggil library
package ggplot2.
Ide dasar dari Single Moving Average (SMA) adalah data suatu periode dipengaruhi oleh data periode sebelumnya. Metode pemulusan ini cocok digunakan untuk pola data stasioner atau konstan. Prinsip dasar metode pemulusan ini adalah data pemulusan pada periode ke-t merupakan rata rata dari m buah data pada periode ke-t hingga periode ke (t-m+1). Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1
Pemulusan menggunakan metode SMA dilakukan dengan fungsi
SMA(). Dalam hal ini akan dilakukan pemulusan dengan
parameter m=4.
data.sma<-SMA(train_ma.ts, n=4)
data.sma
## Time Series:
## Start = 1
## End = 96
## Frequency = 1
## [1] NA NA NA 126059.00 135572.25 131183.75 119658.50
## [8] 110448.50 104710.75 99998.75 98496.75 99156.25 90423.50 87709.75
## [15] 94451.75 98104.75 101161.75 102799.00 102965.75 103250.25 112538.75
## [22] 116980.00 115652.00 130398.50 135518.75 136273.25 142834.00 136203.00
## [29] 127740.25 127480.25 115662.00 107537.50 107167.50 112818.50 113722.50
## [36] 117838.00 109474.50 98524.00 107871.00 104894.25 108637.75 120697.75
## [43] 114811.50 130357.75 146955.50 178546.75 222533.75 246102.75 281777.50
## [50] 318197.00 316108.00 299234.75 283435.25 215076.25 186790.25 182634.75
## [57] 165212.00 179515.50 200450.50 229341.75 251058.00 271897.50 270077.00
## [64] 241705.25 223649.75 186366.50 177527.75 177964.25 176233.00 199655.50
## [71] 200398.00 214400.25 243266.00 254615.75 278238.75 289116.50 286884.50
## [78] 275185.75 300149.75 312323.00 317944.75 357427.25 314286.75 289152.25
## [85] 253472.25 188227.50 167035.25 147112.50 140321.50 159279.00 175200.50
## [92] 189851.75 216208.00 222418.50 274461.75 351153.50
Data pemulusan pada periode ke-t selanjutnya digunakan sebagai nilai peramalan pada periode ke t+1 sehingga hasil peramalan 1 periode kedepan adalah sebagai berikut.
data.ramal<-c(NA,data.sma)
data.ramal #forecast 1 periode ke depan
## [1] NA NA NA NA 126059.00 135572.25 131183.75
## [8] 119658.50 110448.50 104710.75 99998.75 98496.75 99156.25 90423.50
## [15] 87709.75 94451.75 98104.75 101161.75 102799.00 102965.75 103250.25
## [22] 112538.75 116980.00 115652.00 130398.50 135518.75 136273.25 142834.00
## [29] 136203.00 127740.25 127480.25 115662.00 107537.50 107167.50 112818.50
## [36] 113722.50 117838.00 109474.50 98524.00 107871.00 104894.25 108637.75
## [43] 120697.75 114811.50 130357.75 146955.50 178546.75 222533.75 246102.75
## [50] 281777.50 318197.00 316108.00 299234.75 283435.25 215076.25 186790.25
## [57] 182634.75 165212.00 179515.50 200450.50 229341.75 251058.00 271897.50
## [64] 270077.00 241705.25 223649.75 186366.50 177527.75 177964.25 176233.00
## [71] 199655.50 200398.00 214400.25 243266.00 254615.75 278238.75 289116.50
## [78] 286884.50 275185.75 300149.75 312323.00 317944.75 357427.25 314286.75
## [85] 289152.25 253472.25 188227.50 167035.25 147112.50 140321.50 159279.00
## [92] 175200.50 189851.75 216208.00 222418.50 274461.75 351153.50
Selanjutnya akan dilakukan peramalan sejumlah data uji yaitu 24 periode. Pada metode SMA, hasil peramalan 24 periode ke depan akan bernilai sama dengan hasil peramalan 1 periode kedepan. Dalam hal ini akan dilakukan pengguabungan data aktual train, data hasil pemulusan dan data hasil ramalan 24 periode kedepan.
data.gab<-cbind(aktual=c(train_ma.ts,rep(NA,24)),pemulusan=c(data.sma,rep(NA,24)),ramalan=c(data.ramal,rep(data.ramal[length(data.ramal)],23)))
data.gab #forecast 24 periode ke depan
## aktual pemulusan ramalan
## [1,] 97907 NA NA
## [2,] 136954 NA NA
## [3,] 141112 NA NA
## [4,] 128263 126059.00 NA
## [5,] 135960 135572.25 126059.00
## [6,] 119400 131183.75 135572.25
## [7,] 95011 119658.50 131183.75
## [8,] 91423 110448.50 119658.50
## [9,] 113009 104710.75 110448.50
## [10,] 100552 99998.75 104710.75
## [11,] 89003 98496.75 99998.75
## [12,] 94061 99156.25 98496.75
## [13,] 78078 90423.50 99156.25
## [14,] 89697 87709.75 90423.50
## [15,] 115971 94451.75 87709.75
## [16,] 108673 98104.75 94451.75
## [17,] 90306 101161.75 98104.75
## [18,] 96246 102799.00 101161.75
## [19,] 116638 102965.75 102799.00
## [20,] 109811 103250.25 102965.75
## [21,] 127460 112538.75 103250.25
## [22,] 114011 116980.00 112538.75
## [23,] 111326 115652.00 116980.00
## [24,] 168797 130398.50 115652.00
## [25,] 147941 135518.75 130398.50
## [26,] 117029 136273.25 135518.75
## [27,] 137569 142834.00 136273.25
## [28,] 142273 136203.00 142834.00
## [29,] 114090 127740.25 136203.00
## [30,] 115989 127480.25 127740.25
## [31,] 90296 115662.00 127480.25
## [32,] 109775 107537.50 115662.00
## [33,] 112610 107167.50 107537.50
## [34,] 138593 112818.50 107167.50
## [35,] 93912 113722.50 112818.50
## [36,] 126237 117838.00 113722.50
## [37,] 79156 109474.50 117838.00
## [38,] 94791 98524.00 109474.50
## [39,] 131300 107871.00 98524.00
## [40,] 114330 104894.25 107871.00
## [41,] 94130 108637.75 104894.25
## [42,] 143031 120697.75 108637.75
## [43,] 107755 114811.50 120697.75
## [44,] 176515 130357.75 114811.50
## [45,] 160521 146955.50 130357.75
## [46,] 269396 178546.75 146955.50
## [47,] 283703 222533.75 178546.75
## [48,] 270791 246102.75 222533.75
## [49,] 303220 281777.50 246102.75
## [50,] 415074 318197.00 281777.50
## [51,] 275347 316108.00 318197.00
## [52,] 203298 299234.75 316108.00
## [53,] 240022 283435.25 299234.75
## [54,] 141638 215076.25 283435.25
## [55,] 162203 186790.25 215076.25
## [56,] 186676 182634.75 186790.25
## [57,] 170331 165212.00 182634.75
## [58,] 198852 179515.50 165212.00
## [59,] 245943 200450.50 179515.50
## [60,] 302241 229341.75 200450.50
## [61,] 257196 251058.00 229341.75
## [62,] 282210 271897.50 251058.00
## [63,] 238661 270077.00 271897.50
## [64,] 188754 241705.25 270077.00
## [65,] 184974 223649.75 241705.25
## [66,] 133077 186366.50 223649.75
## [67,] 203306 177527.75 186366.50
## [68,] 190500 177964.25 177527.75
## [69,] 178049 176233.00 177964.25
## [70,] 226767 199655.50 176233.00
## [71,] 206276 200398.00 199655.50
## [72,] 246509 214400.25 200398.00
## [73,] 293512 243266.00 214400.25
## [74,] 272166 254615.75 243266.00
## [75,] 300768 278238.75 254615.75
## [76,] 290020 289116.50 278238.75
## [77,] 284584 286884.50 289116.50
## [78,] 225371 275185.75 286884.50
## [79,] 400624 300149.75 275185.75
## [80,] 338713 312323.00 300149.75
## [81,] 307071 317944.75 312323.00
## [82,] 383301 357427.25 317944.75
## [83,] 228062 314286.75 357427.25
## [84,] 238175 289152.25 314286.75
## [85,] 164351 253472.25 289152.25
## [86,] 122322 188227.50 253472.25
## [87,] 143293 167035.25 188227.50
## [88,] 158484 147112.50 167035.25
## [89,] 137187 140321.50 147112.50
## [90,] 198152 159279.00 140321.50
## [91,] 206979 175200.50 159279.00
## [92,] 217089 189851.75 175200.50
## [93,] 242612 216208.00 189851.75
## [94,] 222994 222418.50 216208.00
## [95,] 415152 274461.75 222418.50
## [96,] 523856 351153.50 274461.75
## [97,] NA NA 351153.50
## [98,] NA NA 351153.50
## [99,] NA NA 351153.50
## [100,] NA NA 351153.50
## [101,] NA NA 351153.50
## [102,] NA NA 351153.50
## [103,] NA NA 351153.50
## [104,] NA NA 351153.50
## [105,] NA NA 351153.50
## [106,] NA NA 351153.50
## [107,] NA NA 351153.50
## [108,] NA NA 351153.50
## [109,] NA NA 351153.50
## [110,] NA NA 351153.50
## [111,] NA NA 351153.50
## [112,] NA NA 351153.50
## [113,] NA NA 351153.50
## [114,] NA NA 351153.50
## [115,] NA NA 351153.50
## [116,] NA NA 351153.50
## [117,] NA NA 351153.50
## [118,] NA NA 351153.50
## [119,] NA NA 351153.50
## [120,] NA NA 351153.50
Adapun plot data deret waktu dari hasil peramalan yang dilakukan adalah sebagai berikut.
ts.plot(datampdw.ts, xlab="Time Period ", ylab="Volume Saham", main= "SMA N=4 Data Sales")
points(datampdw.ts)
lines(data.gab[,2],col="green",lwd=2)
lines(data.gab[,3],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.5)
Selanjutnya perhitungan akurasi dilakukan dengan ukuran akurasi Sum Squares Error (SSE), Mean Square Error (MSE) dan Mean Absolute Percentage Error (MAPE). Perhitungan akurasi dilakukan baik pada data latih maupun pada data uji.
#Menghitung nilai keakuratan data latih
error_train.sma = train_ma.ts-data.ramal[1:length(train_ma.ts)]
SSE_train.sma = sum(error_train.sma[5:length(train_ma.ts)]^2)
MSE_train.sma = mean(error_train.sma[5:length(train_ma.ts)]^2)
MAPE_train.sma = mean(abs((error_train.sma[5:length(train_ma.ts)]/train_ma.ts[5:length(train_ma.ts)])*100))
akurasi_train.sma <- matrix(c(SSE_train.sma, MSE_train.sma, MAPE_train.sma))
row.names(akurasi_train.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.sma) <- c("Akurasi m = 4")
akurasi_train.sma
## Akurasi m = 4
## SSE 3.553100e+11
## MSE 3.862065e+09
## MAPE 2.153036e+01
Dalam hal ini nilai MAPE data latih pada metode pemulusan SMA kurang dari 3%, nilai ini dapat dikategorikan sebagai nilai akurasi yang sangat baik. Selanjutnya dilakukan perhitungan nilai MAPE data uji pada metode pemulusan SMA.
#Menghitung nilai keakuratan data uji
error_test.sma = test_ma.ts-data.gab[97:120,3]
SSE_test.sma = sum(error_test.sma^2)
MSE_test.sma = mean(error_test.sma^2)
MAPE_test.sma = mean(abs((error_test.sma/test_ma.ts*100)))
akurasi_test.sma <- matrix(c(SSE_test.sma, MSE_test.sma, MAPE_test.sma))
row.names(akurasi_test.sma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.sma) <- c("Akurasi m = 4")
akurasi_test.sma
## Akurasi m = 4
## SSE 4.442887e+11
## MSE 1.851203e+10
## MAPE 2.365940e+01
Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE sebanyak 2.3% yang kurang dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.
Metode pemulusan Double Moving Average (DMA) pada dasarnya mirip dengan SMA. Namun demikian, metode ini lebih cocok digunakan untuk pola data trend. Proses pemulusan dengan rata rata dalam metode ini dilakukan sebanyak 2 kali.
dma <- SMA(data.sma, n = 4)
At <- 2*data.sma - dma
Bt <- 2/(4-1)*(data.sma - dma)
data.dma<- At+Bt
data.ramal2<- c(NA, data.dma)
t = 1:24
f = c()
for (i in t) {
f[i] = At[length(At)] + Bt[length(Bt)]*(i)
}
data.gab2 <- cbind(aktual = c(train_ma.ts,rep(NA,24)), pemulusan1 = c(data.sma,rep(NA,24)),pemulusan2 = c(data.dma, rep(NA,24)),At = c(At, rep(NA,24)), Bt = c(Bt,rep(NA,24)),ramalan = c(data.ramal2, f[-1]))
data.gab2
## aktual pemulusan1 pemulusan2 At Bt ramalan
## [1,] 97907 NA NA NA NA NA
## [2,] 136954 NA NA NA NA NA
## [3,] 141112 NA NA NA NA NA
## [4,] 128263 126059.00 NA NA NA NA
## [5,] 135960 135572.25 NA NA NA NA
## [6,] 119400 131183.75 NA NA NA NA
## [7,] 95011 119658.50 105558.71 111198.62 -5639.9167 NA
## [8,] 91423 110448.50 87503.08 96681.25 -9178.1667 105558.71
## [9,] 113009 104710.75 85061.38 92921.12 -7859.7500 87503.08
## [10,] 100552 99998.75 85489.79 91293.38 -5803.5833 85061.38
## [11,] 89003 98496.75 90301.85 93579.81 -3277.9583 85489.79
## [12,] 94061 99156.25 96765.62 97721.88 -956.2500 90301.85
## [13,] 78078 90423.50 79431.31 83828.19 -4396.8750 96765.62
## [14,] 89697 87709.75 77315.06 81472.94 -4157.8750 79431.31
## [15,] 115971 94451.75 96979.15 95968.19 1010.9583 77315.06
## [16,] 108673 98104.75 107158.60 103537.06 3621.5417 96979.15
## [17,] 90306 101161.75 110836.33 106966.50 3869.8333 107158.60
## [18,] 96246 102799.00 108915.15 106468.69 2446.4583 110836.33
## [19,] 116638 102965.75 105812.31 104673.69 1138.6250 108915.15
## [20,] 109811 103250.25 104427.02 103956.31 470.7083 105812.31
## [21,] 127460 112538.75 124455.94 119689.06 4766.8750 104427.02
## [22,] 114011 116980.00 130390.52 125026.31 5364.2083 124455.94
## [23,] 111326 115652.00 121563.25 119198.75 2364.5000 130390.52
## [24,] 168797 130398.50 149575.48 141904.69 7670.7917 121563.25
## [25,] 147941 135518.75 153654.48 146400.19 7254.2917 149575.48
## [26,] 117029 136273.25 147627.62 143085.88 4541.7500 153654.48
## [27,] 137569 142834.00 153797.12 149411.88 4385.2500 147627.62
## [28,] 142273 136203.00 133695.92 134698.75 -1002.8333 153797.12
## [29,] 114090 127740.25 114369.62 119717.88 -5348.2500 133695.92
## [30,] 115989 127480.25 117340.04 121396.12 -4056.0833 114369.62
## [31,] 90296 115662.00 97146.38 104552.62 -7406.2500 117340.04
## [32,] 109775 107537.50 87425.00 95470.00 -8045.0000 97146.38
## [33,] 112610 107167.50 95010.31 99873.19 -4862.8750 87425.00
## [34,] 138593 112818.50 116188.71 114840.62 1348.0833 95010.31
## [35,] 93912 113722.50 119407.50 117133.50 2274.0000 116188.71
## [36,] 126237 117838.00 126090.29 122789.38 3300.9167 119407.50
## [37,] 79156 109474.50 102826.38 105485.62 -2659.2500 126090.29
## [38,] 94791 98524.00 79581.08 87158.25 -7577.1667 102826.38
## [39,] 131300 107871.00 106944.54 107315.12 -370.5833 79581.08
## [40,] 114330 104894.25 104399.77 104597.56 -197.7917 106944.54
## [41,] 94130 108637.75 114731.08 112293.75 2437.3333 104399.77
## [42,] 143031 120697.75 137652.02 130870.31 6781.7083 114731.08
## [43,] 107755 114811.50 119063.48 117362.69 1700.7917 137652.02
## [44,] 176515 130357.75 149910.35 142089.31 7821.0417 119063.48
## [45,] 160521 146955.50 178205.29 165705.38 12499.9167 149910.35
## [46,] 269396 178546.75 238344.88 214425.62 23919.2500 178205.29
## [47,] 283703 222533.75 310759.27 275469.06 35290.2083 238344.88
## [48,] 270791 246102.75 325382.85 293670.81 31712.0417 310759.27
## [49,] 303220 281777.50 364339.69 331314.81 33024.8750 325382.85
## [50,] 415074 318197.00 403270.75 369241.25 34029.5000 364339.69
## [51,] 275347 316108.00 358710.81 341669.69 17041.1250 403270.75
## [52,] 203298 299234.75 291577.15 294640.19 -3063.0417 358710.81
## [53,] 240022 283435.25 248754.42 262626.75 -13872.3333 291577.15
## [54,] 141638 215076.25 109430.73 151688.94 -42258.2083 248754.42
## [55,] 162203 186790.25 87883.79 127446.38 -39562.5833 109430.73
## [56,] 186676 182634.75 125385.79 148285.38 -22899.5833 87883.79
## [57,] 170331 165212.00 128184.81 142995.69 -14810.8750 125385.79
## [58,] 198852 179515.50 181144.46 180492.88 651.5833 128184.81
## [59,] 245943 200450.50 231279.35 218947.81 12331.5417 181144.46
## [60,] 302241 229341.75 288861.44 265053.56 23807.8750 231279.35
## [61,] 257196 251058.00 311002.27 287024.56 23977.7083 288861.44
## [62,] 282210 271897.50 328081.77 305608.06 22473.7083 311002.27
## [63,] 238661 270077.00 294216.06 284560.44 9655.6250 328081.77
## [64,] 188754 241705.25 213406.60 224726.06 -11319.4583 294216.06
## [65,] 184974 223649.75 176678.71 195467.12 -18788.4167 213406.60
## [66,] 133077 186366.50 112894.62 142283.38 -29388.7500 176678.71
## [67,] 203306 177527.75 127886.81 147743.19 -19856.3750 112894.62
## [68,] 190500 177964.25 155609.56 164551.44 -8941.8750 127886.81
## [69,] 178049 176233.00 170749.88 172943.12 -2193.2500 155609.56
## [70,] 226767 199655.50 227672.79 216465.88 11206.9167 170749.88
## [71,] 206276 200398.00 220123.52 212233.31 7890.2083 227672.79
## [72,] 246509 214400.25 242281.19 231128.81 11152.3750 220123.52
## [73,] 293512 243266.00 291326.10 272102.06 19224.0417 242281.19
## [74,] 272166 254615.75 298692.00 281061.50 17630.5000 291326.10
## [75,] 300768 278238.75 329253.02 308847.31 20405.7083 298692.00
## [76,] 290020 289116.50 327128.58 311923.75 15204.8333 329253.02
## [77,] 284584 286884.50 303002.21 296555.12 6447.0833 327128.58
## [78,] 225371 275185.75 263234.71 268015.12 -4780.4167 303002.21
## [79,] 400624 300149.75 320675.79 312465.38 8210.4167 263234.71
## [80,] 338713 312323.00 343468.42 331010.25 12458.1667 320675.79
## [81,] 307071 317944.75 345517.98 334488.69 11029.2917 343468.42
## [82,] 383301 357427.25 416537.35 392893.31 23644.0417 345517.98
## [83,] 228062 314286.75 295605.60 303078.06 -7472.4583 416537.35
## [84,] 238175 289152.25 238234.75 258601.75 -20367.0000 295605.60
## [85,] 164351 253472.25 169951.62 203359.88 -33408.2500 238234.75
## [86,] 122322 188227.50 66465.52 115170.31 -48704.7917 169951.62
## [87,] 143293 167035.25 71307.65 109598.69 -38291.0417 66465.52
## [88,] 158484 147112.50 77363.54 105263.12 -27899.5833 71307.65
## [89,] 137187 140321.50 106400.35 119968.81 -13568.4583 77363.54
## [90,] 198152 159279.00 169015.56 165120.94 3894.6250 106400.35
## [91,] 206979 175200.50 208070.71 194922.62 13148.0833 169015.56
## [92,] 217089 189851.75 229332.69 213540.31 15792.3750 208070.71
## [93,] 242612 216208.00 267996.65 247281.19 20715.4583 229332.69
## [94,] 222994 222418.50 258249.85 243917.31 14332.5417 267996.65
## [95,] 415152 274461.75 355673.00 323188.50 32484.5000 258249.85
## [96,] 523856 351153.50 492975.27 436246.56 56728.7083 355673.00
## [97,] NA NA NA NA NA 492975.27
## [98,] NA NA NA NA NA 549703.98
## [99,] NA NA NA NA NA 606432.69
## [100,] NA NA NA NA NA 663161.40
## [101,] NA NA NA NA NA 719890.10
## [102,] NA NA NA NA NA 776618.81
## [103,] NA NA NA NA NA 833347.52
## [104,] NA NA NA NA NA 890076.23
## [105,] NA NA NA NA NA 946804.94
## [106,] NA NA NA NA NA 1003533.65
## [107,] NA NA NA NA NA 1060262.35
## [108,] NA NA NA NA NA 1116991.06
## [109,] NA NA NA NA NA 1173719.77
## [110,] NA NA NA NA NA 1230448.48
## [111,] NA NA NA NA NA 1287177.19
## [112,] NA NA NA NA NA 1343905.90
## [113,] NA NA NA NA NA 1400634.60
## [114,] NA NA NA NA NA 1457363.31
## [115,] NA NA NA NA NA 1514092.02
## [116,] NA NA NA NA NA 1570820.73
## [117,] NA NA NA NA NA 1627549.44
## [118,] NA NA NA NA NA 1684278.15
## [119,] NA NA NA NA NA 1741006.85
## [120,] NA NA NA NA NA 1797735.56
Hasil pemulusan menggunakan metode DMA divisualisasikan sebagai berikut
ts.plot(datampdw.ts, xlab="Time Period ", ylab="Sales", main= "DMA N=4 Data Sales")
points(datampdw.ts)
lines(data.gab2[,3],col="green",lwd=2)
lines(data.gab2[,6],col="red",lwd=2)
legend("topleft",c("data aktual","data pemulusan","data peramalan"), lty=8, col=c("black","green","red"), cex=0.8)
Selanjutnya perhitungan akurasi dilakukan baik pada data latih maupun data uji. Perhitungan akurasi dilakukan dengan ukuran akurasi SSE, MSE dan MAPE.
#Menghitung nilai keakuratan data latih
error_train.dma = train_ma.ts-data.ramal2[1:length(train_ma.ts)]
SSE_train.dma = sum(error_train.dma[8:length(train_ma.ts)]^2)
MSE_train.dma = mean(error_train.dma[8:length(train_ma.ts)]^2)
MAPE_train.dma = mean(abs((error_train.dma[8:length(train_ma.ts)]/train_ma.ts[8:length(train_ma.ts)])*100))
akurasi_train.dma <- matrix(c(SSE_train.dma, MSE_train.dma, MAPE_train.dma))
row.names(akurasi_train.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_train.dma) <- c("Akurasi m = 4")
akurasi_train.dma
## Akurasi m = 4
## SSE 3.251812e+11
## MSE 3.653721e+09
## MAPE 2.378664e+01
Perhitungan akurasi pada data latih menggunakan nilai MAPE menghasilkan nilai MAPE sebesar 2.38% yang kurang dari 10% sehingga dikategorikan sangat baik. Selanjutnya, perhitungan nilai akurasi dilakukan pada data uji.
#Menghitung nilai keakuratan data uji
error_test.dma = test_ma.ts-data.gab2[97:120,6]
SSE_test.dma = sum(error_test.dma^2)
MSE_test.dma = mean(error_test.dma^2)
MAPE_test.dma = mean(abs((error_test.dma/test_ma.ts*100)))
akurasi_test.dma <- matrix(c(SSE_test.dma, MSE_test.dma, MAPE_test.dma))
row.names(akurasi_test.dma)<- c("SSE", "MSE", "MAPE")
colnames(akurasi_test.dma) <- c("Akurasi m = 4")
akurasi_test.dma
## Akurasi m = 4
## SSE 1.431972e+13
## MSE 5.966548e+11
## MAPE 1.500678e+02
Perhitungan akurasi menggunakan data latih menghasilkan nilai MAPE sebesar 1.5% yang kurang dari 10% sehingga nilai akurasi ini dapat dikategorikan sebagai sangat baik.
Pada data latih, metode SMA lebih baik dibandingkan dengan metode DMA, sedangkan pada data uji, metode DMA lebih baik dibandingkan SMA
Metode Exponential Smoothing adalah metode pemulusan dengan melakukan pembobotan menurun secara eksponensial. Nilai yang lebih baru diberi bobot yang lebih besar dari nilai terdahulu. Terdapat satu atau lebih parameter pemulusan yang ditentukan secara eksplisit, dan hasil pemilihan parameter tersebut akan menentukan bobot yang akan diberikan pada nilai pengamatan. Ada dua macam model, yaitu model tunggal dan ganda.
Pembagian data latih dan data uji dilakukan dengan perbandingan 80% data latih dan 20% data uji.
#membagi training dan testing
training<-datampdw[1:96,]
testing<-datampdw[97:120,]
train.ts <- ts(training$x)
test.ts <- ts(testing$x)
Eksplorasi dilakukan dengan membuat plot data deret waktu untuk keseluruhan data, data latih, dan data uji.
#eksplorasi data
plot(datampdw.ts, col="black",main="Plot semua data")
points(datampdw.ts)
plot(train.ts, col="red",main="Plot data latih")
points(train.ts)
plot(test.ts, col="blue",main="Plot data uji")
points(test.ts)
Single Exponential Smoothing merupakan metode pemulusan yang tepat digunakan untuk data dengan pola stasioner atau konstan.
Nilai pemulusan pada periode ke-t didapat dari persamaan:
Nilai parameter adalah nilai antara 0 dan 1.
Nilai pemulusan periode ke-t bertindak sebagai nilai ramalan pada periode ke-.
Pemulusan dengan metode SES dapat dilakukan dengan dua fungsi dari
packages berbeda, yaitu (1) fungsi ses() dari
packages forecast dan (2) fungsi
HoltWinters dari packages stats .
#Cara 1 (fungsi ses)
ses.1 <- ses(train.ts, h = 24, alpha = 0.2)
plot(ses.1)
ses.1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 306318.5 223663.8 388973.3 179909.0 432728.1
## 98 306318.5 222026.9 390610.2 177405.6 435231.5
## 99 306318.5 220421.2 392215.9 174949.9 437687.2
## 100 306318.5 218844.9 393792.1 172539.2 440097.9
## 101 306318.5 217296.6 395340.5 170171.3 442465.8
## 102 306318.5 215774.8 396862.3 167843.8 444793.3
## 103 306318.5 214278.1 398359.0 165554.8 447082.3
## 104 306318.5 212805.3 399831.7 163302.4 449334.6
## 105 306318.5 211355.4 401281.6 161085.0 451552.1
## 106 306318.5 209927.3 402709.7 158900.9 453736.2
## 107 306318.5 208520.1 404117.0 156748.7 455888.4
## 108 306318.5 207132.8 405504.3 154627.1 458010.0
## 109 306318.5 205764.7 406872.4 152534.7 460102.4
## 110 306318.5 204414.9 408222.2 150470.4 462166.7
## 111 306318.5 203082.8 409554.3 148433.0 464204.0
## 112 306318.5 201767.6 410869.5 146421.7 466215.4
## 113 306318.5 200468.8 412168.3 144435.3 468201.8
## 114 306318.5 199185.7 413451.4 142473.0 470164.1
## 115 306318.5 197917.8 414719.3 140533.9 472103.1
## 116 306318.5 196664.6 415972.5 138617.3 474019.8
## 117 306318.5 195425.5 417211.6 136722.3 475914.8
## 118 306318.5 194200.1 418436.9 134848.3 477788.8
## 119 306318.5 192988.0 419649.1 132994.5 479642.6
## 120 306318.5 191788.7 420848.4 131160.3 481476.8
ses.2<- ses(train.ts, h = 24, alpha = 0.7)
plot(ses.2)
ses.2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 474230.3 408310.4 540150.2 373414.5 575046.1
## 98 474230.3 393764.8 554695.8 351168.9 597291.7
## 99 474230.3 381472.8 566987.8 332369.9 616090.7
## 100 474230.3 370629.0 577831.6 315785.8 632674.8
## 101 474230.3 360817.4 587643.2 300780.2 647680.4
## 102 474230.3 351789.5 596671.1 286973.2 661487.3
## 103 474230.3 343383.0 605077.6 274116.6 674343.9
## 104 474230.3 335484.9 612975.6 262037.6 686423.0
## 105 474230.3 328012.9 620447.7 250610.0 697850.6
## 106 474230.3 320904.5 627556.1 239738.7 708721.9
## 107 474230.3 314111.4 634349.2 229349.6 719111.0
## 108 474230.3 307595.0 640865.6 219383.6 729077.0
## 109 474230.3 301324.0 647136.6 209792.9 738667.7
## 110 474230.3 295272.6 653188.0 200538.1 747922.4
## 111 474230.3 289419.3 659041.3 191586.2 756874.4
## 112 474230.3 283745.7 664714.9 182909.3 765551.3
## 113 474230.3 278236.3 670224.3 174483.4 773977.2
## 114 474230.3 272877.6 675583.0 166287.9 782172.6
## 115 474230.3 267657.9 680802.7 158305.0 790155.5
## 116 474230.3 262566.8 685893.8 150518.9 797941.6
## 117 474230.3 257595.4 690865.2 142915.8 805544.8
## 118 474230.3 252735.5 695725.1 135483.2 812977.4
## 119 474230.3 247979.9 700480.6 128210.2 820250.3
## 120 474230.3 243322.3 705138.2 121087.1 827373.5
Untuk mendapatkan gambar hasil pemulusan pada data latih dengan
fungsi ses() , perlu digunakan fungsi
autoplot() dan autolayer() dari library
packages ggplot2 .
autoplot(ses.1) +
autolayer(fitted(ses.1), series="Fitted") +
ylab("Membaca") + xlab("Periode")
Pada fungsi ses() , terdapat beberapa argumen yang umum
digunakan, yaitu nilia y , gamma ,
beta , alpha , dan h .
Nilai y adalah nilai data deret waktu,
gamma adalah parameter pemulusan untuk komponen musiman,
beta adalah parameter pemulusan untuk tren, dan
alpha adalah parameter pemulusan untuk stasioner, serta
h adalah banyaknya periode yang akan diramalkan.
Kasus di atas merupakan contoh inisialisasi nilai parameter dengan nilai alpha
0,2 dan 0,7 dan banyak periode data yang akan diramalkan adalah sebanyak
10 periode. Selanjutnya akan digunakan fungsi HoltWinters()
dengan nilai inisialisasi parameter dan panjang periode peramalan yang
sama dengan fungsi ses() .
#Cara 2 (fungsi Holtwinter)
ses1<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.2)
plot(ses1)
#ramalan
ramalan1<- forecast(ses1, h=24)
ramalan1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 306318.5 224766.8 387870.3 181595.9 431041.2
## 98 306318.5 223151.7 389485.4 179125.9 433511.2
## 99 306318.5 221567.4 391069.6 176702.9 435934.2
## 100 306318.5 220012.2 392624.8 174324.5 438312.6
## 101 306318.5 218484.6 394152.5 171988.1 440649.0
## 102 306318.5 216983.0 395654.0 169691.7 442945.4
## 103 306318.5 215506.3 397130.8 167433.2 445203.8
## 104 306318.5 214053.2 398583.9 165210.9 447426.2
## 105 306318.5 212622.7 400014.4 163023.1 449614.0
## 106 306318.5 211213.6 401423.4 160868.1 451768.9
## 107 306318.5 209825.2 402811.9 158744.7 453892.4
## 108 306318.5 208456.4 404180.7 156651.3 455985.8
## 109 306318.5 207106.5 405530.6 154586.8 458050.2
## 110 306318.5 205774.8 406862.3 152550.1 460087.0
## 111 306318.5 204460.4 408176.7 150540.0 462097.1
## 112 306318.5 203162.8 409474.3 148555.4 464081.7
## 113 306318.5 201881.3 410755.8 146595.6 466041.5
## 114 306318.5 200615.3 412021.7 144659.5 467977.6
## 115 306318.5 199364.4 413272.7 142746.3 469890.8
## 116 306318.5 198127.9 414509.2 140855.2 471781.9
## 117 306318.5 196905.3 415731.7 138985.5 473651.6
## 118 306318.5 195696.3 416940.8 137136.5 475500.6
## 119 306318.5 194500.4 418136.7 135307.4 477329.7
## 120 306318.5 193317.1 419320.0 133497.7 479139.4
ses2<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE, alpha = 0.7)
plot(ses2)
#ramalan
ramalan2<- forecast(ses2, h=24)
ramalan2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 474230.3 408694.6 539766.0 374002.1 574458.5
## 98 474230.3 394233.8 554226.8 351886.2 596574.4
## 99 474230.3 382013.4 566447.2 333196.7 615263.9
## 100 474230.3 371232.8 577227.7 316709.3 631751.3
## 101 474230.3 361478.4 586982.2 301791.2 646669.4
## 102 474230.3 352503.1 595957.5 288064.7 660395.9
## 103 474230.3 344145.6 604314.9 275283.0 673177.6
## 104 474230.3 336293.6 612167.0 263274.3 685186.3
## 105 474230.3 328865.1 619595.5 251913.4 696547.2
## 106 474230.3 321798.1 626662.4 241105.4 707355.1
## 107 474230.3 315044.6 633416.0 230776.8 717683.8
## 108 474230.3 308566.2 639894.4 220868.9 727591.6
## 109 474230.3 302331.8 646128.8 211334.2 737126.4
## 110 474230.3 296315.6 652144.9 202133.3 746327.3
## 111 474230.3 290496.4 657964.2 193233.6 755227.0
## 112 474230.3 284855.9 663604.7 184607.2 763853.4
## 113 474230.3 279378.6 669081.9 176230.4 772230.2
## 114 474230.3 274051.2 674409.4 168082.7 780377.8
## 115 474230.3 268861.9 679598.7 160146.4 788314.2
## 116 474230.3 263800.5 684660.1 152405.6 796054.9
## 117 474230.3 258858.0 689602.6 144846.8 803613.8
## 118 474230.3 254026.4 694434.1 137457.5 811003.0
## 119 474230.3 249298.6 699162.0 130227.0 818233.6
## 120 474230.3 244668.2 703792.4 123145.3 825315.3
Fungsi HoltWinters memiliki argumen yang sama dengan
fungsi ses() . Argumen-argumen kedua fungsi dapat dilihat
lebih lanjut dengan ?ses() atau ?HoltWinters
.
Nilai parameter dari
kedua fungsi dapat dioptimalkan menyesuaikan dari error-nya
paling minimumnya. Caranya adalah dengan membuat parameter NULL .
#SES
ses.opt <- ses(train.ts, h = 24, alpha = NULL)
plot(ses.opt)
ses.opt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 498440.3 433083.4 563797.1 398485.54 598395.0
## 98 498440.3 413851.3 583029.2 369072.56 627807.9
## 99 498440.3 398245.1 598635.4 345204.95 651675.6
## 100 498440.3 384761.5 612119.0 324583.66 672296.8
## 101 498440.3 372715.8 624164.7 306161.37 690719.1
## 102 498440.3 361727.4 635153.1 289356.00 707524.5
## 103 498440.3 351558.7 645321.8 273804.37 723076.1
## 104 498440.3 342049.9 654830.6 259261.79 737618.7
## 105 498440.3 333086.9 663793.6 245554.12 751326.4
## 106 498440.3 324585.4 672295.1 232552.21 764328.3
## 107 498440.3 316480.7 680399.8 220157.11 776723.4
## 108 498440.3 308721.9 688158.6 208291.05 788589.5
## 109 498440.3 301268.2 695612.4 196891.55 799989.0
## 110 498440.3 294086.1 702794.4 185907.57 810972.9
## 111 498440.3 287148.1 709732.4 175296.74 821583.8
## 112 498440.3 280430.7 716449.8 165023.42 831857.1
## 113 498440.3 273914.2 722966.3 155057.31 841823.2
## 114 498440.3 267581.6 729298.9 145372.41 851508.1
## 115 498440.3 261418.1 735462.4 135946.18 860934.3
## 116 498440.3 255410.9 741469.6 126758.92 870121.6
## 117 498440.3 249548.6 747331.9 117793.35 879087.2
## 118 498440.3 243821.3 753059.2 109034.14 887846.4
## 119 498440.3 238220.0 758660.5 100467.66 896412.8
## 120 498440.3 232736.7 764143.8 92081.75 904798.8
#Lamda Optimum Holt Winter
sesopt<- HoltWinters(train.ts, gamma = FALSE, beta = FALSE,alpha = NULL)
sesopt
## Holt-Winters exponential smoothing without trend and without seasonal component.
##
## Call:
## HoltWinters(x = train.ts, alpha = NULL, beta = FALSE, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.8227594
## beta : FALSE
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 498634.4
plot(sesopt)
#ramalan
ramalanopt<- forecast(sesopt, h=24)
ramalanopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 498634.4 433605.4 563663.5 399181.06 598087.8
## 98 498634.4 414424.1 582844.7 369845.86 627423.0
## 99 498634.4 398864.8 598404.0 346049.96 651218.9
## 100 498634.4 385424.1 611844.7 325494.19 671774.6
## 101 498634.4 373417.9 623850.9 307132.30 690136.5
## 102 498634.4 362466.2 634802.6 290383.16 706885.7
## 103 498634.4 352332.1 644936.7 274884.31 722384.5
## 104 498634.4 342855.8 654413.0 260391.62 736877.2
## 105 498634.4 333923.9 663345.0 246731.35 750537.5
## 106 498634.4 325451.9 671816.9 233774.68 763494.2
## 107 498634.4 317375.6 679893.3 221422.94 775845.9
## 108 498634.4 309644.0 687624.8 209598.56 787670.3
## 109 498634.4 302216.6 695052.3 198239.26 799029.6
## 110 498634.4 295059.9 702208.9 187294.13 809974.7
## 111 498634.4 288146.5 709122.3 176720.93 820547.9
## 112 498634.4 281453.0 715815.8 166484.12 830784.7
## 113 498634.4 274959.7 722309.1 156553.52 840715.3
## 114 498634.4 268649.7 728619.1 146903.18 850365.7
## 115 498634.4 262508.3 734760.6 137510.63 859758.2
## 116 498634.4 256522.5 740746.3 128356.26 868912.6
## 117 498634.4 250681.3 746587.6 119422.82 877846.0
## 118 498634.4 244974.5 752294.3 110695.04 886573.8
## 119 498634.4 239393.3 757875.5 102159.35 895109.5
## 120 498634.4 233929.8 763339.1 93803.58 903465.3
Setelah dilakukan peramalan, akan dilakukan perhitungan keakuratan hasil peramalan. Perhitungan akurasi ini dilakukan baik pada data latih dan data uji.
Perhitungan akurasi data dapat dilakukan dengan cara langsung maupun manual. Secara langsung, nilai akurasi dapat diambil dari objek yang tersimpan pada hasil SES, yaitu sum of squared errors (SSE). Nilai akurasi lain dapat dihitung pula dari nilai SSE tersebut.
#Keakuratan Metode
#Pada data training
SSE1<-ses1$SSE
MSE1<-ses1$SSE/length(train.ts)
RMSE1<-sqrt(MSE1)
akurasi1 <- matrix(c(SSE1,MSE1,RMSE1))
row.names(akurasi1)<- c("SSE", "MSE", "RMSE")
colnames(akurasi1) <- c("Akurasi lamda=0.2")
akurasi1
## Akurasi lamda=0.2
## SSE 3.920775e+11
## MSE 4.084141e+09
## RMSE 6.390728e+04
SSE2<-ses2$SSE
MSE2<-ses2$SSE/length(train.ts)
RMSE2<-sqrt(MSE2)
akurasi2 <- matrix(c(SSE2,MSE2,RMSE2))
row.names(akurasi2)<- c("SSE", "MSE", "RMSE")
colnames(akurasi2) <- c("Akurasi lamda=0.7")
akurasi2
## Akurasi lamda=0.7
## SSE 2.488591e+11
## MSE 2.592282e+09
## RMSE 5.091446e+04
#Cara Manual
fitted1<-ramalan1$fitted
sisaan1<-ramalan1$residuals
head(sisaan1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 39047.0000 35395.6000 15467.4800 20070.9840 -503.2128
resid1<-training$x-ramalan1$fitted
head(resid1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 39047.0000 35395.6000 15467.4800 20070.9840 -503.2128
#Cara Manual
SSE.1=sum(sisaan1[2:length(train.ts)]^2)
SSE.1
## [1] 392077527560
MSE.1 = SSE.1/length(train.ts)
MSE.1
## [1] 4084140912
MAPE.1 = sum(abs(sisaan1[2:length(train.ts)]/train.ts[2:length(train.ts)])*
100)/length(train.ts)
MAPE.1
## [1] 21.75827
akurasi.1 <- matrix(c(SSE.1,MSE.1,MAPE.1))
row.names(akurasi.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.1) <- c("Akurasi lamda=0.2")
akurasi.1
## Akurasi lamda=0.2
## SSE 3.920775e+11
## MSE 4.084141e+09
## MAPE 2.175827e+01
fitted2<-ramalan2$fitted
sisaan2<-ramalan2$residuals
head(sisaan2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 39047.000 15872.100 -8087.370 5270.789 -14978.763
resid2<-training$x-ramalan2$fitted
head(resid2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA 39047.000 15872.100 -8087.370 5270.789 -14978.763
SSE.2=sum(sisaan2[2:length(train.ts)]^2)
SSE.2
## [1] 248859116938
MSE.2 = SSE.2/length(train.ts)
MSE.2
## [1] 2592282468
MAPE.2 = sum(abs(sisaan2[2:length(train.ts)]/train.ts[2:length(train.ts)])*
100)/length(train.ts)
MAPE.2
## [1] 17.66957
akurasi.2 <- matrix(c(SSE.2,MSE.2,MAPE.2))
row.names(akurasi.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasi.2) <- c("Akurasi lamda=0.7")
akurasi.2
## Akurasi lamda=0.7
## SSE 2.488591e+11
## MSE 2.592282e+09
## MAPE 1.766957e+01
Berdasarkan nilai SSE, MSE, RMSE, dan MAPE di antara kedua parameter, nilai parameter menghasilkan akurasi yang lebih baik dibanding . Hal ini dilihat dari nilai masing-masing ukuran akurasi yang lebih kecil. Berdasarkan nilai MAPE-nya, hasil ini dapat dikategorikan sebagai peramalan sangat baik.
Akurasi data uji dapat dihitung dengan cara yang hampir sama dengan perhitungan akurasi data latih.
selisih1<-ramalan1$mean-testing$x
SSEtesting1<-sum(selisih1^2)
MSEtesting1<-SSEtesting1/length(testing)
selisih2<-ramalan2$mean-testing$x
SSEtesting2<-sum(selisih2^2)
MSEtesting2<-SSEtesting2/length(testing)
selisihopt<-ramalanopt$mean-testing$x
SSEtestingopt<-sum(selisihopt^2)
MSEtestingopt<-SSEtestingopt/length(testing)
akurasitesting1 <- matrix(c(SSEtesting1,SSEtesting2,SSEtestingopt))
row.names(akurasitesting1)<- c("SSE1", "SSE2", "SSEopt")
akurasitesting1
## [,1]
## SSE1 721606264719
## SSE2 179007160725
## SSEopt 212785575544
akurasitesting2 <- matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt))
row.names(akurasitesting2)<- c("MSE1", "MSE2", "MSEopt")
akurasitesting2
## [,1]
## MSE1 360803132359
## MSE2 89503580362
## MSEopt 106392787772
Selain dengan cara di atas, perhitungan nilai akurasi dapat
menggunakan fungsi accuracy() dari package
forecast . Penggunaannya yaitu dengan menuliskan
accuracy(hasil ramalan, kondisi aktual) . Contohnya adalah
sebagai berikut.
#cara lain
accuracy(ramalanopt,testing$x)
## ME RMSE MAE MPE MAPE MASE
## Training set 5126.874 50734.38 34913.79 -1.020569 18.25255 0.960577
## Test set -41038.043 94159.79 73409.72 -13.179694 18.74972 2.019709
## ACF1
## Training set -0.02144522
## Test set NA
Metode pemulusan Double Exponential Smoothing (DES) digunakan untuk data yang memiliki pola tren. Metode DES adalah metode semacam SES, hanya saja dilakukan dua kali, yaitu pertama untuk tahapan ‘level’ dan kedua untuk tahapan ‘tren’. Pemulusan menggunakan metode ini akan menghasilkan peramalan tidak konstan untuk periode berikutnya.
Pemulusan dengan metode DES kali ini akan menggunakan fungsi
HoltWinters() . Jika sebelumnya nilai argumen
beta dibuat FALSE , kali ini argumen tersebut
akan diinisialisasi bersamaan dengan nilai alpha .
#Lamda=0.2 dan gamma=0.2
des.1<- HoltWinters(train.ts, gamma = FALSE, beta = 0.2, alpha = 0.2)
plot(des.1)
#ramalan
ramalandes1<- forecast(des.1, h=24)
ramalandes1
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 300147.1 194005.9 406288.2 137818.22 462475.9
## 98 316947.1 207791.9 426102.3 150008.61 483885.6
## 99 333747.1 220618.4 446875.8 160731.64 506762.5
## 100 350547.1 232429.6 468664.6 169901.99 531192.2
## 101 367347.1 243202.8 491491.4 177484.79 557209.4
## 102 384147.1 252943.6 515350.6 183488.68 584805.5
## 103 400947.1 261679.6 540214.6 187955.82 613938.4
## 104 417747.1 269453.1 566041.1 190951.00 644543.2
## 105 434547.1 276314.9 592779.3 192551.88 676542.4
## 106 451347.1 282319.3 620375.0 192841.30 709853.0
## 107 468147.1 287520.0 648774.3 191901.77 744392.5
## 108 484947.1 291968.7 677925.6 189812.04 780082.3
## 109 501747.2 295713.0 707781.3 186645.14 816849.2
## 110 518547.2 298796.6 738297.8 182467.62 854626.7
## 111 535347.2 301258.4 769435.9 177339.35 893355.0
## 112 552147.2 303133.6 801160.7 171313.85 932980.5
## 113 568947.2 304453.4 833441.0 164438.78 973455.6
## 114 585747.2 305245.3 866249.1 156756.52 1014737.8
## 115 602547.2 305534.0 899560.3 148304.76 1056789.6
## 116 619347.2 305341.6 933352.8 139117.09 1099577.3
## 117 636147.2 304687.6 967606.8 129223.53 1143070.9
## 118 652947.2 303589.7 1002304.7 118650.96 1187243.5
## 119 669747.2 302063.5 1037430.9 107423.57 1232070.9
## 120 686547.2 300123.5 1072970.9 95563.17 1277531.3
#Lamda=0.6 dan gamma=0.3
des.2<- HoltWinters(train.ts, gamma = FALSE, beta = 0.3, alpha = 0.6)
plot(des.2)
#ramalan
ramalandes2<- forecast(des.2, h=24)
ramalandes2
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 535420.7 465327.0 605514.5 428221.6 642619.9
## 98 601260.9 512366.1 690155.8 465308.0 737213.9
## 99 667101.1 555610.1 778592.1 496590.4 837611.9
## 100 732941.3 595772.2 870110.4 523159.3 942723.3
## 101 798781.5 633324.5 964238.5 545736.9 1051826.1
## 102 864621.7 668584.5 1060658.8 564808.7 1164434.7
## 103 930461.9 701775.6 1159148.1 580716.4 1280207.4
## 104 996302.1 733062.8 1259541.3 593712.3 1398891.8
## 105 1062142.2 762573.5 1361711.0 603991.4 1520293.1
## 106 1127982.4 790409.7 1465555.1 611709.5 1644255.4
## 107 1193822.6 816655.5 1570989.7 616995.3 1770649.9
## 108 1259662.8 841382.0 1677943.6 619957.5 1899368.1
## 109 1325503.0 864650.3 1786355.6 620689.7 2030316.3
## 110 1391343.2 886514.1 1896172.2 619273.8 2163412.6
## 111 1457183.4 907020.8 2007345.9 615782.3 2298584.4
## 112 1523023.5 926212.9 2119834.2 610280.5 2435766.6
## 113 1588863.7 944128.9 2233598.5 602826.9 2574900.5
## 114 1654703.9 960803.7 2348604.1 593475.2 2715932.6
## 115 1720544.1 976269.5 2464818.7 582274.4 2858813.8
## 116 1786384.3 990555.8 2582212.7 569269.7 3003498.9
## 117 1852224.5 1003690.0 2700758.9 554503.0 3149945.9
## 118 1918064.7 1015697.6 2820431.7 538013.3 3298116.0
## 119 1983904.8 1026602.3 2941207.4 519837.0 3447972.7
## 120 2049745.0 1036426.4 3063063.6 500008.0 3599482.1
Selanjutnya jika ingin membandingkan plot data latih dan data uji adalah sebagai berikut.
#Visually evaluate the prediction
plot(datampdw.ts)
lines(des.1$fitted[,1], lty=2, col="blue")
lines(ramalandes1$mean, col="red")
Untuk mendapatkan nilai parameter optimum dari DES, argumen
alpha dan beta dapat dibuat NULL
seperti berikut.
#Lamda dan gamma optimum
des.opt<- HoltWinters(train.ts, gamma = FALSE)
des.opt
## Holt-Winters exponential smoothing with trend and without seasonal component.
##
## Call:
## HoltWinters(x = train.ts, gamma = FALSE)
##
## Smoothing parameters:
## alpha: 0.7844551
## beta : 0.2122358
## gamma: FALSE
##
## Coefficients:
## [,1]
## a 499607.77
## b 54145.85
plot(des.opt)
#ramalan
ramalandesopt<- forecast(des.opt, h=24)
ramalandesopt
## Point Forecast Lo 80 Hi 80 Lo 95 Hi 95
## 97 553753.6 485312.4 622194.9 449081.7 658425.5
## 98 607899.5 513453.1 702345.8 463456.2 752342.7
## 99 662045.3 540517.2 783573.5 476184.1 847906.6
## 100 716191.2 566221.8 866160.6 486832.8 945549.6
## 101 770337.0 590490.0 950184.1 495284.7 1045389.4
## 102 824482.9 613316.5 1035649.3 501531.8 1147434.0
## 103 878628.7 634724.5 1122533.0 505609.4 1251648.1
## 104 932774.6 654747.9 1210801.3 507569.5 1357979.7
## 105 986920.5 673424.8 1300416.1 507470.3 1466370.6
## 106 1041066.3 690793.5 1391339.1 505370.3 1576762.3
## 107 1095212.2 706891.4 1483533.0 501326.7 1689097.6
## 108 1149358.0 721753.9 1576962.1 495394.0 1803322.1
## 109 1203503.9 735414.8 1671592.9 487623.4 1919384.3
## 110 1257649.7 747905.7 1767393.8 478063.4 2037236.0
## 111 1311795.6 759256.1 1864335.1 466759.3 2156831.8
## 112 1365941.4 769493.9 1962389.0 453753.6 2278129.3
## 113 1420087.3 778645.1 2061529.5 439086.1 2401088.5
## 114 1474233.1 786734.2 2161732.1 422794.2 2525672.0
## 115 1528379.0 793784.3 2262973.7 404913.3 2651844.7
## 116 1582524.9 799816.9 2365232.8 385476.4 2779573.3
## 117 1636670.7 804852.6 2468488.8 364514.7 2908826.7
## 118 1690816.6 808910.7 2572722.4 342058.0 3039575.2
## 119 1744962.4 812009.5 2677915.4 318134.0 3171790.8
## 120 1799108.3 814166.2 2784050.3 292769.4 3305447.1
Selanjutnya akan dilakukan perhitungan akurasi pada data latih maupun data uji dengan ukuran akurasi SSE, MSE dan MAPE.
#Akurasi Data Training
ssedes.train1<-des.1$SSE
msedes.train1<-ssedes.train1/length(train.ts)
sisaandes1<-ramalandes1$residuals
head(sisaandes1)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -34889.00 -78411.64 -89547.29 -119130.91
mapedes.train1 <- sum(abs(sisaandes1[3:length(train.ts)]/train.ts[3:length(train.ts)])
*100)/length(train.ts)
akurasides.1 <- matrix(c(ssedes.train1,msedes.train1,mapedes.train1))
row.names(akurasides.1)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.1) <- c("Akurasi lamda=0.2 dan gamma=0.2")
akurasides.1
## Akurasi lamda=0.2 dan gamma=0.2
## SSE 6.412284e+11
## MSE 6.679462e+09
## MAPE 3.621965e+01
ssedes.train2<-des.2$SSE
msedes.train2<-ssedes.train2/length(train.ts)
sisaandes2<-ramalandes2$residuals
head(sisaandes2)
## Time Series:
## Start = 1
## End = 6
## Frequency = 1
## [1] NA NA -34889.00 -59571.58 -38175.73 -47002.76
mapedes.train2 <- sum(abs(sisaandes2[3:length(train.ts)]/train.ts[3:length(train.ts)])
*100)/length(train.ts)
akurasides.2 <- matrix(c(ssedes.train2,msedes.train2,mapedes.train2))
row.names(akurasides.2)<- c("SSE", "MSE", "MAPE")
colnames(akurasides.2) <- c("Akurasi lamda=0.6 dan gamma=0.3")
akurasides.2
## Akurasi lamda=0.6 dan gamma=0.3
## SSE 2.784438e+11
## MSE 2.900457e+09
## MAPE 2.107291e+01
Hasil akurasi dari data latih didapatkan skenario 2 dengan lamda=0.6 dan gamma=0.3 memiliki hasil yang lebih baik dikarenakan memiliki SSE, MSE dan MAPE yang lebih kecil. Namun untuk kedua skenario dapat dikategorikan peramalan sangat baik berdasarkan nilai MAPE-nya.
#Akurasi Data Testing
selisihdes1<-ramalandes1$mean-testing$x
selisihdes1
## Time Series:
## Start = 97
## End = 120
## Frequency = 1
## [1] -172224.921 -34971.915 -52369.909 32731.097 83390.103 -54695.891
## [7] 28885.115 -48304.879 -54178.872 -22029.866 -52517.860 -39596.854
## [13] 86599.152 76206.158 562.164 69172.170 238337.176 46010.182
## [19] 148476.188 45346.194 -12941.800 169507.206 226161.213 150467.219
SSEtestingdes1<-sum(selisihdes1^2)
MSEtestingdes1<-SSEtestingdes1/length(testing$x)
MAPEtestingdes1<-sum(abs(selisihdes1/testing$x)*100)/length(testing$x)
selisihdes2<-ramalandes2$mean-testing$x
selisihdes2
## Time Series:
## Start = 97
## End = 120
## Frequency = 1
## [1] 63048.75 249341.94 280984.12 415125.31 514824.49 425778.68
## [7] 558399.86 530250.05 573416.24 654605.42 673157.61 735118.79
## [13] 910354.98 949002.17 922398.35 1040048.54 1258253.72 1114966.91
## [19] 1266473.09 1212383.28 1203135.47 1434624.65 1540318.84 1513665.02
SSEtestingdes2<-sum(selisihdes2^2)
MSEtestingdes2<-SSEtestingdes2/length(testing$x)
MAPEtestingdes2<-sum(abs(selisihdes2/testing$x)*100)/length(testing$x)
selisihdesopt<-ramalandesopt$mean-testing$x
selisihdesopt
## Time Series:
## Start = 97
## End = 120
## Frequency = 1
## [1] 81381.62 255980.47 275928.33 398375.18 486380.04 385639.89
## [7] 506566.75 466722.60 498194.45 567689.31 574547.16 624814.02
## [13] 788355.87 815308.73 777010.58 882966.44 1089477.29 934496.14
## [19] 1074308.00 1008523.85 987581.71 1207376.56 1301376.42 1263028.27
SSEtestingdesopt<-sum(selisihdesopt^2)
MSEtestingdesopt<-SSEtestingdesopt/length(testing$x)
MAPEtestingdesopt<-sum(abs(selisihdesopt/testing$x)*100)/length(testing$x)
akurasitestingdes <-
matrix(c(SSEtestingdes1,MSEtestingdes1,MAPEtestingdes1,SSEtestingdes2,MSEtestingdes2,
MAPEtestingdes2,SSEtestingdesopt,MSEtestingdesopt,MAPEtestingdesopt),
nrow=3,ncol=3)
row.names(akurasitestingdes)<- c("SSE", "MSE", "MAPE")
colnames(akurasitestingdes) <- c("des ske1","des ske2","des opt")
akurasitestingdes
## des ske1 des ske2 des opt
## SSE 2.593627e+11 2.083909e+13 1.508068e+13
## MSE 1.080678e+10 8.682954e+11 6.283619e+11
## MAPE 1.889296e+01 1.818946e+02 1.575722e+02
MSEfull <-
matrix(c(MSEtesting1,MSEtesting2,MSEtestingopt,MSEtestingdes1,MSEtestingdes2,
MSEtestingdesopt),nrow=3,ncol=2)
row.names(MSEfull)<- c("ske 1", "ske 2", "ske opt")
colnames(MSEfull) <- c("SES","DES")
MSEfull
## SES DES
## ske 1 360803132359 10806779715
## ske 2 89503580362 868295369128
## ske opt 106392787772 628361861428
Kedua metode dapat dibandingkan dengan menggunakan ukuran akurasi yang sama. Contoh di atas adalah perbandingan kedua metode dengan ukuran akurasi MSE. Hasilnya didapatkan metode DES lebih baik dibandingkan metode SES pada ske 1 dilihat dari MSE yang lebih kecil nilainya sedangkan ske 2 dan ske opt SES lebih baik daripada DES dari MSE yang lebih kecil nilainya.